perm filename SIMPLE.SAI[SYS,HE]3 blob
sn#016492 filedate 1972-12-12 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00007 00002 BEGIN "SIMPLE"
00012 00003 EXTERNAL PROCEDURES - TO BE FOUND IN SIMAUX.SAI
00016 00004 PROCEDURE WAIT
00020 00005 SIMP_ERASE,PIECE_OF_GLASS,LINE_OF_SIGHT,FACE_NORMAL
00023 00006 PROCEDURE FC(SAFE REAL ARRAY ITEMVAR OBJ,ESAFE REAL ARRAY THISOBREAL DOT)
00025 00007 PROCEDURE FINDX(SAFE REAL ARRAY ITEMVAR X1,X2,X3,MX1,MX2,MX3)
00029 00008 PROCEDURE GLOBALIZE (SAFE REAL ARRAY ITEMVAR OBJITEMVAR PROTOSAFE REAL ARRAY TT)
00033 00009 MESSAGE PROCEDURE SIMP_UPDATE(REAL ARRAY ITEMVAR OBJREAL ARRAY NEWT
00038 00010 MESSAGE PROCEDURE UNGLOBALIZE (SAFE REAL ARRAY ITEMVAR OBJ)
00040 00011 MESSAGE PROCEDURE SIMP_FIT (ITEM BLOBQREFERENCE INTEGER STATUS
00045 00012 simp_fit (continued) - pick the possibilities set
00049 00013 simp_fit (continued) - possibilities continued
00054 00014 simp_fit (continued) - model matching
00057 00015 simp_fit (continued) - match three vectors
00063 00016 simp_fit (continued) - get transform and finish
00064 00017 INITIALIZATION AND COMMAND SCANNER
00067 ENDMK
⊗;
BEGIN "SIMPLE"
REQUIRE 400 PNAMES;
REQUIRE 400 NEW_ITEMS;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
REQUIRE "<>||" DELIMITERS;
EXTERNAL REAL PROCEDURE SQRT(REAL X);
EXTERNAL REAL PROCEDURE ACOS(REAL X);
EXTERNAL REAL PROCEDURE ATAN(REAL X);
EXTERNAL REAL PROCEDURE COSD(REAL X);
EXTERNAL REAL PROCEDURE SIND(REAL X);
COMMENT ***** LOCAL THINGS ***** ;
SAFE REAL ARRAY AI,AII[1:3,1:3];
SAFE REAL ARRAY A1[1:7],MU,MV,MW,VL1,VL2,VL3,CP1,CP2,MCP1,MCP2,INT[1:3];
SAFE REAL ARRAY TT[1:4,1:4],SIZE1[1:4], OUTPNT[1:4,0:30];
SAFE REAL ARRAY CFRAME,LOS,NORM[1:4],NH,NT[1:4];
SAFE REAL ARRAY aaaa[1:4,1:4];
SAFE REAL ARRAY MVL1,MVL2,MVL3[1:3];
SAFE INTEGER ARRAY BUF[1:300];
REAL MAG,LL1,LL2,LL3,DOT,LEN1,LEN2,DP1,DP2,MDP1,MDP2,MDP3;
ITEM LINK,UHEAD,UTAIL,UDOT,VHEAD,VTAIL,VDOT,WHEAD,WTAIL,WDOT,NO_ITEM;
ITEMVAR PPTYPE,U,V,W,IVX,VAL,OBJ;
SAFE REAL ARRAY ITEMVAR XX, THISOB,X1,X3,X4,X5,MV1,MV2,MV3,MV4,B1,B2,B3,OBJ_CAM;
SAFE REAL ARRAY ITEMVAR VT,VH,UT,UH,WT,WH;
REAL ITEMVAR UX,WX,VX,XR;
SET SL1,SL2,SL3,S2,S3,S4,ATRSET,POSSIBILITIES,SETPE,SETE,SETV,SETW,
SETU,SU,SV,SW,STS,EDGESET;
INTEGER BREAK,EOF,I,J,K,NOVERT,DIRECTIVE,D_FRAM,INDEX,
DAVEX,DAVEY,AVEX,AVEY,OUTCNT,EDGECNT,VERT0S;
BOOLEAN SEND_MESS;
STRING CURMES,STR;
LABEL GETDISK,monrun;
COMMENT ***** EXTERNAL VARIABLES IN FILE SIMAUX.SAI *****;
EXTERNAL ITEMVAR TTT,NEXTSYM;
EXTERNAL SAFE REAL ARRAY A[1:3,1:3],LENS[1:3];
COMMENT A AND AI MATRICES FOR THE OBJECT BEING CONSIDERED
AT THE MOMENT -- A IS COLINEATION MATRIX (TABLE → SCREEN)
AND AI ITS INVERSE (SCREEN → TABLE).
BOTH MUST BE POST-MULTIPLIED ;
EXTERNAL SAFE REAL ARRAY MCP[1:3];
EXTERNAL SAFE REAL ARRAY CTABLE[1:4];
EXTERNAL REAL LX,MDP;
EXTERNAL ITEMVAR Y,L1,L2,L3;
EXTERNAL SAFE REAL ARRAY ITEMVAR X,V1,V2,V3,V4,B,VA,VB;
EXTERNAL SET SES,SVS,S1,VERTEDG;
EXTERNAL INTEGER C,ICX,ICY,SPECIAL_VERT,
VERT0F;
EXTERNAL BOOLEAN BVERT;
DEFINE SIMP_INIT=<
IF ¬GOT_MODELS
THEN BEGIN
TYPE "NEED GLOBAL MODEL - RUN MAKSEG.DMP[SYS,HE]" EOM;
CALL(0,"EXIT");
END>;
DEFINE FILE=<7>,
SIBS=<13>,
α=<COMMENT>,
$=<GLOBAL>,
ID=<7>,
FIRST1=<8>,
SOMETHING=<9>,
TYPET = <IF TYP_SIMP THEN TYPE>,
TYPED = <IF DEB_SIMP THEN TYPE>,
⊂= <BEGIN>,
⊃=<END>,
∀= <FOREACH>,
∂= <DATUM>,
YES= <(INCHWL="Y")>,
TYPE= <OUTSTR(>,
EOM= <&'12&'15)>,
EOS= <)>,
TTY= <1>,
#####= <COMMENT;>,
SORRY= <IF TYP_SIMP
THEN TYPE "SORRY, I CAN'T RECOGNIZE THE CUBE" EOM >,
ADJ(L1,L2)=<((ENDPT⊗L1) ∩ (ENDPT⊗L2) ≠ PHI)>,
GADJ(L1,L2)=<((GLOBAL ENDPT⊗L1) ∩ (GLOBAL ENDPT⊗L2) ≠ PHI)>;
DEFINE LAEQ(A,B)"{}"= {ABS(A-B)<0.49};
DEFINE S1U= <STEP 1 UNTIL>,
ASSIGN= <FOREACH>,
HOLDS= <DO DONE>,
READ= <INTN(GETS)>,
READS(A)= <INTNS(GETS,A)>,
READA(A)= <INTNA(GETS,A)>,
TYP_ARRAY(NAME,ID,R,C)=<BEGIN STRING S;INTEGER I,J;
TYPE ID EOM;
FOR I←1 STEP 1 UNTIL R DO
BEGIN S←NULL;
FOR J←1 STEP 1 UNTIL C DO
S←S&CVG(NAME[I,J]);
TYPE S EOM;
END;
END>;
COMMENT EXTERNAL PROCEDURES - TO BE FOUND IN SIMAUX.SAI;
EXTERNAL PROCEDURE READ_FROM_DISK;
EXTERNAL ITEMVAR PROCEDURE INTN(STRING S);
EXTERNAL REAL ITEMVAR PROCEDURE INTNS(STRING S;REAL V);
EXTERNAL SAFE REAL ARRAY ITEMVAR PROCEDURE INTNA(STRING S;SAFE REAL ARRAY A);
EXTERNAL STRING PROCEDURE GETS;
EXTERNAL PROCEDURE INVERT(SAFE REAL ARRAY MAT,INVMAT;INTEGER N);
EXTERNAL PROCEDURE TRANSPOSE(SAFE REAL ARRAY TO,FROM);
EXTERNAL PROCEDURE HOMO_XFRM(SAFE REAL ARRAY P,T);
EXTERNAL PROCEDURE WXFORM(SAFE REAL ARRAY FRUM,TU,TRANS);
EXTERNAL PROCEDURE IMAGE_POINT(SAFE REAL ARRAY V;REFERENCE INTEGER X,Y);
EXTERNAL INTERNAL PROCEDURE BESTIN(SAFE REAL ARRAY PJ,QJ,PK,QK,INT;REFERENCE REAL MISDIS);
EXTERNAL INTERNAL PROCEDURE MATMULT(SAFE REAL ARRAY A,TIMESB,EQUALSC;INTEGER N);
EXTERNAL STRING PROCEDURE PRINTNAME(ITEMVAR X);
EXTERNAL STRING PROCEDURE GENSYM (ITEMVAR X);
EXTERNAL PROCEDURE SINGULAR(INTEGER WHY);
EXTERNAL PROCEDURE DECOMPOSE(INTEGER N;SAFE REAL ARRAY A,LU);
EXTERNAL PROCEDURE SOLVE(INTEGER N;SAFE REAL ARRAY LU,B,X);
EXTERNAL PROCEDURE IMPROVE(INTEGER N;SAFE REAL ARRAY A,LU,B,X;REFERENCE REAL DIGITS);
EXTERNAL REAL PROCEDURE ACCUMDOTPROD
(INTEGER N;SAFE REAL ARRAY A;INTEGER I; SAFE REAL ARRAY X; REAL EXTRATERM);
EXTERNAL BOOLEAN PROCEDURE VERT(ITEM E);
EXTERNAL REAL PROCEDURE LENTH(ITEM L);
EXTERNAL REAL PROCEDURE GLENTH(ITEM L);
EXTERNAL ITEMVAR PROCEDURE NEXTV(SAFE REAL ARRAY ITEM V1,V2);
EXTERNAL PROCEDURE CROSS_PROD(REFERENCE SAFE REAL ARRAY A,B,CP);
EXTERNAL ITEMVAR PROCEDURE HIGHEST(SET S);
EXTERNAL ITEMVAR PROCEDURE LOWEST(SET S);
EXTERNAL PROCEDURE VERT_LINE_PT(SAFE REAL ARRAY ITEM T,B);
EXTERNAL PROCEDURE VERT_PLANE_PT(SAFE REAL ARRAY ITEM T,B1,B2);
EXTERNAL PROCEDURE HORIZ_PLANE_PT(SAFE REAL ARRAY ITEM U,K);
EXTERNAL REAL PROCEDURE DOT_PROD(SAFE REAL ARRAY V1,V2);
EXTERNAL REAL PROCEDURE ANGLE(SAFE REAL ARRAY ITEM P1,P2,P3);
EXTERNAL BOOLEAN PROCEDURE PARALLEL(ITEM E1,E2);
EXTERNAL PROCEDURE VERT0;
EXTERNAL PROCEDURE VERT1;
EXTERNAL PROCEDURE VERT2;
PROCEDURE WAIT;
WHILE DEB_SIMP ∧ ¬RUN DO
BEGIN "WAIT" STRING S;INTEGER I,J;SAFE REAL ARRAY ITEMVAR X;SET SV;
TYPE '12&'15&"SIMPLE WAITING" EOM;
S←INCHRW;
IF S="D" ∧ DIS_SIMP
THEN DPYOUT(D_FRAM)
ELSE
IF S="C"
THEN BEGIN
TYPE "AMERA TRANSFORM FOR CURRENT OBJECT" EOM;
STR←"CAMERA TRANSFORM";
TYP_ARRAY(A,STR,3,3);
STR←"CAMERA INVERSE";
TYP_ARRAY(AI,STR,3,3);
TYPE "LENS CENTER" EOM;
TYPE CVG(LENS[1])&CVG(LENS[2])&CVG(LENS[3]) EOM;
END
ELSE
IF S="V"
THEN BEGIN
TYPE "ERTICALS" EOM;
∀ X|XεVERTEDG DO TYPE PRINTNAME(X)&" ");
TYPE "" EOM;
END
ELSE
IF S="P"
THEN BEGIN
TYPE "OINT" );
S←INCHRW;
TYPE '12&'15&"DATUM:" );
X←CVSI("POINT"&S,J);
IF J
THEN TYPE "POINT"&S&" NOT DEFINED" EOM
ELSE BEGIN
S←NULL;
FOR J←1 STEP 1 UNTIL 6 DO
S←S&CVG(∂(X)[J]);
TYPE S EOM;
END
END
ELSE
IF S="L"
THEN BEGIN
TYPE "INE");
S←INCHRW;
TYPE '12&'15&"ENDPOINTS:");
X←CVSI("LINE"&S,J);
IF J
THEN TYPE "LINE"&S&" NOT DEFINED" EOM
ELSE BEGIN
SV←(ENDPT⊗X);
∀ X|XεSV DO TYPE " "&PRINTNAME(X)&" ");
END
END
ELSE DONE;
END "WAIT";
PROCEDURE DEBUG_UPDATE;
while true do
begin "DEBUG UPDATE PROCEDURE"
type "simp_update???" eom;
if inchwl="Y"
then begin
real mag,deg,sinv,cosv,x,y;integer i,j,k;
string str;
type "delta x:"); x←realscan(str←inchwl,I);
type "delta y:"); y←realscan(str←inchwl,i);
type "rotation:"); deg←realscan(str←inchwl,i);
type "("&cvg(x)&","&cvg(y)&","&cvg(deg)&")" eom;
if deg≠0
then begin
for i←1 step 1 until 4 do
for j←1 step 1 until 4 do
aaaa[i,j]←tt[i,j]←if i=j then 1.0 else 0.0;
cosv←cosd(deg);
sinv←sind(deg);
aaaa[1,1]←aaaa[2,2]←cosv;
aaaa[2,1]←-sinv;
aaaa[1,2]←sinv;
STR←"ROTATION ARRAY";
typ_array(aaaa,str,4,4);
MATMULT(A,GLOBAL ∂(THISOB),TT,4);
end
else arrtran(tt,global ∂(thisob));
tt[1,4]←global ∂(thisob)[1,4]+x;
tt[2,4]←global ∂(thisob)[2,4]+y;
TT[3,4]←GLOBAL ∂(THISOB)[3,4];
TT[4,4]←1.0;
SIMP_UPDATE(THISOB,TT,STAT_II);
end
else done; end "DEBUG UPDATE PROCEDURE";
COMMENT SIMP_ERASE,PIECE_OF_GLASS,LINE_OF_SIGHT,FACE_NORMAL;
PROCEDURE SIMP_ERASE;
BEGIN FOREACH Y|YεSES DO BEGIN
ERASE ENDPT⊗Y≡ANY;
DELETE (Y);
END;
FOREACH Y,XX|YεSVS ∧ TTT⊗Y≡XX DO BEGIN
ERASE TTT⊗Y≡XX;DELETE(XX);
DELETE (Y);
END;
SES←PHI; SVS←PHI;
END;
PROCEDURE PIECE_OF_GLASS;
BEGIN "PIECE OF GLASS"
if dis_simp
then begin
if d_fram<0
then d_fram←getpog;
if d_fram<0
then begin outstr("NO FREE FRAMES - SIMPLE"&'15&'12);
dis_simp←false;
end
else dpyset(buf);
end
else if d_fram≥0
then relpog(d_fram);
END "PIECE OF GLASS";
PROCEDURE LINE_OF_SIGHT(SAFE REAL ARRAY LOS);
BEGIN "LINE OF SIGHT"
INTEGER MAG,I;
SAFE REAL ARRAY CTABLE[1:3];
comment find approximate line of sight;
WXFORM(CFRAME,CTABLE,AI);
CTABLE[1]←CTABLE[1]/CTABLE[3];
CTABLE[2]←CTABLE[2]/CTABLE[3];
LOS[1]←CTABLE[1]-LENS[1];
LOS[2]←CTABLE[2]-LENS[2];
LOS[3]←-LENS[3];
MAG←SQRT(LOS[1]↑2+LOS[2]↑2+LOS[3]↑2);
FOR I←1 STEP 1 UNTIL 3 DO LOS[I]←LOS[I]/MAG;
END "LINE OF SIGHT";
PROCEDURE FACE_NORMAL(SAFE REAL ARRAY ITEMVAR PF;SAFE REAL ARRAY NEWT,NORM);
BEGIN "FACE NORMAL"
INTEGER I;REAL MAG;
SAFE REAL ARRAY ITEMVAR VA;
SAFE REAL ARRAY V1,V2,PN[1:4];
ASSIGN VA|GLOBAL CORNER⊗PF≡VA HOLDS;
ARRTRAN(V1,GLOBAL ∂(VA));
ARRTRAN(PN,GLOBAL ∂(PF));
FOR I←1 STEP 1 UNTIL 3 DO V2[I]←V1[I]+PN[I];
V2[4]←1.0;
HOMO_XFRM(V1,NEWT);
HOMO_XFRM(V2,NEWT);
FOR I←1 STEP 1 UNTIL 3 DO NORM[I]←V2[I]-V1[I];
MAG←SQRT(NORM[1]↑2+NORM[2]↑2+NORM[3]↑2);
FOR I←1 STEP 1 UNTIL 3 DO NORM[I]←NORM[I]/MAG;
NORM[4]←ABS(V1[1]*NORM[1]+V1[2]*NORM[2]+V1[3]*NORM[3]);
END "FACE NORMAL";
PROCEDURE FC(SAFE REAL ARRAY ITEMVAR OBJ,E;SAFE REAL ARRAY THISOB;REAL DOT);
BEGIN "FACE CALCULATIONS"
SET S;
SAFE REAL ARRAY ITEMVAR U,V;
SAFE REAL ARRAY AU,AV[1:4];
INTEGER X1,Y1,X2,Y2;
S←(GLOBAL ENDPT⊗E);
U←LOP(S);
V←COP(S);
FOR I←1 S1U 4 DO
BEGIN
AU[I]←GLOBAL DATUM(U)[I];
AV[I]←GLOBAL DATUM(V)[I];
END;
HOMO_XFRM(AU,THISOB);
HOMO_XFRM(AV,THISOB);
IMAGE_POINT(AU,X1,Y1);
IMAGE_POINT(AV,X2,Y2);
AVEX←AVEX+(X1+X2)%2;
AVEY←AVEY+(Y1+Y2)%2;
IF ¬ (TTT⊗OBJ≡E) ∧ DOT<0.0
THEN BEGIN
OUTPNT[1,OUTCNT←OUTCNT+1]←X1;
OUTPNT[2,OUTCNT]←Y1;
OUTPNT[3,OUTCNT]←X2;
OUTPNT[4,OUTCNT]←Y2;
MAKE TTT⊗OBJ≡E;
END;
if dis_simp ∧ DOT<0.0
then begin
x1←3*x1-512;
y1←-3*y1+512;
x2←3*x2-512;
y2←-3*y2+512;
aivect(X1,Y1);
avect(X2,Y2);
end;
END "FACE CALCULATIONS";
PROCEDURE FINDX(SAFE REAL ARRAY ITEMVAR X1,X2,X3,MX1,MX2,MX3);
COMMENT FINDS THE 4X4 TRANSLATION-ROTATION MATRIX NECESSARY TO TAKE
MX1,MX2,MX3 OF PROTOTYPE P INTO X1,X2,X3 OF BODY B.;
BEGIN
INTEGER I,J;
REAL MAG,MAGV2,MAGV3,MAGMV2,MAGMV3;
SAFE REAL ARRAY MX2R,V2,V3,MV2,MV3,U1,U2,U3,MU1,MU2,MU3[1:3];
SAFE REAL ARRAY R1,R2,R2T,R[1:3,1:3];
MAGV2←MAGV3←MAGMV2←MAGMV3←0.0;
FOR I←1 S1U 3 DO
BEGIN
V2[I]←DATUM(X1)[I]-DATUM(X2)[I];
V3[I]←DATUM(X3)[I]-DATUM(X2)[I];
MV2[I]←GLOBAL DATUM(MX1)[I]-GLOBAL DATUM(MX2)[I];
MV3[I]←GLOBAL DATUM(MX3)[I]-GLOBAL DATUM(MX2)[I];
MAGV2←MAGV2+V2[I]↑2;
MAGV3←MAGV3+V3[I]↑2;
MAGMV2←MAGMV2+MV2[I]↑2;
MAGMV3←MAGMV3+MV3[I]↑2;
END;
IF MAGV3 > MAGV2
THEN BEGIN
MAGV2↔MAGV3;
MAGMV2↔MAGMV3;
FOR I←1 S1U 3 DO
BEGIN
V2[I]↔V3[I];
MV2[I]↔MV3[I];
END;
END;
FOR I←1 S1U 3 DO
BEGIN
U2[I]←V2[I]/SQRT(MAGV2);
U3[I]←V3[I]/SQRT(MAGV3);
MU2[I]←MV2[I]/SQRT(MAGMV2);
MU3[I]←MV3[I]/SQRT(MAGMV3);
END;
CROSS_PROD(U3,U2,U1);
MAG←SQRT(DOT_PROD(U1,U1));
FOR I←1 S1U 3 DO U1[I]←U1[I]/MAG;
CROSS_PROD(MU3,MU2,MU1);
MAG←SQRT(DOT_PROD(MU1,MU1));
FOR I←1 S1U 3 DO MU1[I]←MU1[I]/MAG;
CROSS_PROD(U2,U1,U3);
CROSS_PROD(MU2,MU1,MU3);
FOR I←1 S1U 3 DO
BEGIN
R1[I,1]←U1[I];
R1[I,2]←U2[I];
R1[I,3]←U3[I];
R2[I,1]←MU1[I];
R2[I,2]←MU2[I];
R2[I,3]←MU3[I];
END;
FOR I←1 S1U 3 DO
FOR J←1 S1U 3 DO R2T[I,J]←R2[J,I];
MATMULT(R1,R2T,R,3);
FOR I←1 S1U 3 DO
BEGIN MAG←SQRT(R[I,1]↑2 + R[I,2]↑2 + R[I,3]↑2);
FOR J←1 S1U 3 DO R[I,J]←R[I,J]/MAG;
END;
FOR I←1 S1U 3 DO
FOR J←1 S1U 3 DO TT[I,J]←R[I,J];
TT[4,1]←TT[4,2]←TT[4,3]←0.0;TT[4,4]←1.0;
FOR I←1 S1U 3 DO
BEGIN
MX2R[I]←0.0;
FOR J←1 S1U 3 DO MX2R[I]←MX2R[I]+R[I,J]*GLOBAL DATUM(MX2)[J];
END;
FOR I←1 S1U 3 DO TT[I,4]←DATUM(X2)[I]-MX2R[I];
IF TYP_SIMP THEN
BEGIN
TYPE "INSTANCE TRANSFORM FROM SIMPLE" EOM;
FOR I←1 S1U 4 DO
TYPE CVG(TT[I,1])&" "&CVG(TT[I,2])&" "&CVG(TT[I,3])&" "&CVG(TT[I,4]) EOM;
WAIT;
END;
END;
PROCEDURE GLOBALIZE (SAFE REAL ARRAY ITEMVAR OBJ;ITEMVAR PROTO;SAFE REAL ARRAY TT);
BEGIN "GLOBAL MAKES"
COMMENT CREATES THE APPROVED GLOBAL MODEL STRUCTURE FOR THE RECOGNIZED OBJECTS;
INTEGER K,EDGECNT;
REAL MAGNI;
STRING CHAR;
ITEMVAR FOO1;
SAFE REAL ARRAY ITEMVAR FOO,FACEN;
SAFE REAL ARRAY FACE_CENTER[1:2],LOS[1:3],NORM[1:4],FACETT[1:4,1:4];
LINE_OF_SIGHT(LOS);
OUTCNT ← 0;
TYPET "GLOBALIZE THE PROTOTYPE "&PRINTNAME(PROTO) EOM;
TYPET " IT HAS "&CVS(LENGTH($ FACE⊗PROTO))&" FACES" EOM;
∀ X|$ FACE⊗PROTO≡X DO
BEGIN "DO A FACE"
FACE_NORMAL(X,TT,NORM);
FACEN←GLOBAL NEW(NORM);
##### GLOBAL MAKE FACE⊗OBJ≡FACEN;
TYPED "MAKE A GLOBAL FACE FROM PROTOTYPE "&PRINTNAME(PROTO) EOM;
MAKE LINK⊗FACEN≡X;
DOT←0.0;
FOR I←1 S1U 3 DO DOT←DOT+LOS[I]*NORM[I];
AVEX←AVEY←0;
FOREACH Y| GLOBAL BOUNDARY⊗X≡Y DO
FC(OBJ,Y,TT,DOT);
EDGECNT←LENGTH(GLOBAL BOUNDARY⊗X);
FACE_CENTER[1]←AVEX % EDGECNT;
FACE_CENTER[2]←AVEY % EDGECNT;
FOO ← GLOBAL NEW(FACE_CENTER);
##### GLOBAL MAKE CENTER⊗FACEN≡FOO;
##### IF DOT<0.0
THEN GLOBAL MAKE VISIBLE⊗OBJ≡FACEN;
END "DO A FACE";
ERASE TTT⊗OBJ≡ANY;
IF OUTCNT
THEN BEGIN
OUTPNT[1,0] ← OUTCNT;
##### GLOBAL MAKE EDGES⊗OBJ≡GLOBAL NEW(OUTPNT);
END
ELSE TYPE "NO OUTLINE FROM SIMP" EOM;
if deb_simp
then begin "debug"
set sfs;
∀ facen|global face⊗obj≡facen do
begin arrtran(norm,global ∂(facen));
OUTSTR("FACE:"&printname(facen)&"["&
CVG(NORM[1])&CVG(NORM[2])&CVG(NORM[3])&CVG(NORM[4])&"]"&'12&'15);
end;
∀ facen|global visible⊗obj≡facen do
begin type "VISIBLE FACE IS "&PRINTNAME(FACEN) eom;
if dis_simp
then begin
assign foo|global center⊗facen≡foo holds;
AIVECT(3*global ∂(foo)[1]-512,-3*global ∂(foo)[2]+512);
DPYSST("*"&PRINTNAME(FACEN));
end;
end;
type "NUMBER OF VISIBLE EDGES IS "&CVS(OUTCNT) eom;
if dis_simp
then if run
then dpyout(d_fram)
else begin
type "TYPE . TO CONTINUE, ANYTHING ELSE TO RE-DRAW" eom;
do dpyout(D_FRAM) until inchwl=".";
end;
end "debug";
END "GLOBAL MAKES";
MESSAGE PROCEDURE SIMP_UPDATE(REAL ARRAY ITEMVAR OBJ;REAL ARRAY NEWT;
REFERENCE INTEGER STATUS);
BEGIN "UPDATE THE OBJECT"
INTEGER I,J,K,EDGECNT;
STRING STR;
SET S1,SVS,SES;
SAFE REAL ARRAY ITEMVAR F,PF,X,FOO,V,PV;
ITEMVAR P,PE;
SAFE REAL ARRAY OT,NT[1:4,1:4],NORM,TEMP[1:4],FACETT[1:4,1:4];
SAFE REAL ARRAY FACE_CENTER[1:2],LOS[1:3];
INTEGER ITEMVAR Y;
REAL DOT,mag;
STATUS←0;
comment
status meaning
0 all okay
1 no camera transform for obj
2 no visible edges
;
PIECE_OF_GLASS;
comment get rid of old stuff;
∀ F|GLOBAL VISIBLE⊗OBJ≡F DO
BEGIN ;
GLOBAL ERASE VISIBLE⊗OBJ≡F;
GLOBAL ERASE CENTER⊗F≡ANY;
END;
GLOBAL ERASE EDGES⊗OBJ≡ANY;
comment get the camera model and line of sight;
S1 ← GLOBAL XFORM ⊗ OBJ;
IF LENGTH(S1)=0
THEN ⊂ TYPE "NO CAMERA TRANSFORM FOR OBJ - SIMP_UPDATE" EOM;
STATUS←1;
RETURN ⊃
ELSE ⊂ X←COP (S1);
ARRBLT(A[1,1],GLOBAL ∂(X)[1,1],9);
ARRBLT(LENS[1],GLOBAL ∂(X)[4,1],3);
ARRBLT(CFRAME[1],GLOBAL ∂(X)[5,1],3);
ARRBLT(AI[1,1],GLOBAL ∂(x)[6,1],9);
LINE_OF_SIGHT(LOS) ⊃;
ARRTRAN(GLOBAL ∂(OBJ),NEWT);
OUTCNT←0;
∀ F,PF|GLOBAL FACE⊗OBJ≡F ∧ LINK⊗F≡PF DO
BEGIN "DO THE FACES"
FACE_NORMAL(PF,NEWT,NORM);
ARRTRAN(GLOBAL ∂(F),NORM);
AVEX←AVEY←0;
DOT←0.0;
FOR I←1 S1U 3 DO DOT←DOT+LOS[I]*GLOBAL ∂(F)[I];
FOREACH Y| GLOBAL BOUNDARY⊗PF≡Y DO
FC(OBJ,Y,NEWT,DOT);
EDGECNT←LENGTH(GLOBAL BOUNDARY⊗PF);
FACE_CENTER[1]←AVEX % EDGECNT;
FACE_CENTER[2]←AVEY % EDGECNT;
FOO ← GLOBAL NEW(FACE_CENTER);
##### GLOBAL MAKE CENTER⊗F≡FOO;
##### IF DOT<0.0
THEN GLOBAL MAKE VISIBLE⊗OBJ≡F;
END "DO THE FACES";
ERASE TTT⊗OBJ≡ANY;
IF OUTCNT
THEN BEGIN
OUTPNT[1,0] ← OUTCNT;
#####; GLOBAL MAKE EDGES⊗OBJ≡GLOBAL NEW(OUTPNT);
END
ELSE BEGIN
TYPE "NO VISIBLE EDGES ?? - SIMP_UPDATE" EOM;
STATUS←2;
COMMENT RETURN;
END;
begin "debug"
if TYP_SIMP
then ⊂ STR←"NEW OBJECT TRANSFORM";TYP_ARRAY(NEWT,STR,4,4); ⊃;
if deb_simp
then ∀ f|global visible⊗obj≡f do
begin arrtran(norm,global ∂(f));
type "VISIBLE FACE:"&printname(f)&"["&CVG(NORM[1])&
CVG(NORM[2])&CVG(NORM[3])&CVG(NORM[4])&"]" eom;
assign foo|global center⊗f≡foo holds;
if dis_simp
then begin
AIVECT((DAVEX←(3*global ∂(foo)[1])-512),
(DAVEY←(-3*global ∂(foo)[2])+512));
DPYSST("*"&printname(f));
end;
type "FACE CENTER:"&CVG(DAVEX)&CVG(DAVEY)&")" EOM;
end;
IF TYP_SIMP
THEN TYPE "THERE ARE "&CVS(OUTCNT)&" VISIBLE EDGES - SIMP_UPDATE." EOM;
if dis_simp
then if run
then dpyout(d_fram)
else begin
type "TYPE . TO CONTINUE, ANYTHING ELSE TO RE-DRAW" eom;
do dpyout(D_FRAM) until inchrw=".";
end;
end "debug";
END "UPDATE THE OBJECT";
MESSAGE PROCEDURE UNGLOBALIZE (SAFE REAL ARRAY ITEMVAR OBJ);
BEGIN "KILL GLOBAL ASSOCIATIONS"
SAFE REAL ARRAY ITEMVAR F,X,E;
GLOBAL ERASE INSTANCE⊗ANY≡OBJ;
FOREACH F| GLOBAL FACE⊗OBJ≡F DO
BEGIN ;
GLOBAL ERASE FACE⊗OBJ≡F;
GLOBAL DELETE(F);
END;
FOREACH X|GLOBAL VISIBLE⊗OBJ≡X DO
BEGIN ;
GLOBAL ERASE VISIBLE⊗OBJ≡X;
GLOBAL DELETE(X);
END;
FOREACH F,X|GLOBAL CENTER⊗F≡X DO
BEGIN ;
GLOBAL ERASE CENTER⊗F≡X;
GLOBAL DELETE(F);
GLOBAL DELETE(X);
END;
FOREACH E|GLOBAL EDGES⊗OBJ≡E DO
BEGIN ;
GLOBAL ERASE EDGES⊗OBJ≡E;
GLOBAL DELETE(E);
END;
GLOBAL ERASE XFORM⊗OBJ≡ANY;
GLOBAL DELETE(OBJ);
END "KILL GLOBAL ASSOCIATIONS";
MESSAGE PROCEDURE SIMP_FIT (ITEM BLOBQ;REFERENCE INTEGER STATUS;
REFERENCE REAL ARRAY ITEMVAR GOTIT);
BEGIN "SIMP"
BOOLEAN T,SIMP_CUBE;
LABEL LAB12,LAB15,LABA,LABFAIL;
REAL ITEMVAR E1,E2,E3,E4;
INTEGER D;
TYPET "I AM NOW IN SIMPLE" EOM;
STATUS←0;
COMMENT description of STATUS variable returned:
0 = success
1 = no camera transform for blobq
2 = no boundary for blobq
4 = object sides too short
10 = sides = 4 and no verticals (degenerate wedge)
20 = wrong number of edges
;
PIECE_OF_GLASS;
S1 ← GLOBAL XFORM ⊗ BLOBQ ; COMMENT CAMERA MODEL;
##### IF LENGTH(S1)=0
THEN BEGIN TYPE "NO CAMERA XFORM" EOM;
STATUS←status lor 1;
RETURN END;
X←COP (S1);
COMMENT description of camera model:
_________________________
| |
| [3x3 rotation matrix] |
| |
|-----------------------|
| [1x3 camera center] |
|-----------------------|
| [1x3 piercing point] | ← FRAME CENTER
|-----------------------|
| |
| [3x3 inverse matrix] |
| |
|-----------------------|
| pan | tilt | range|
|¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬|
|cam no. | lens no. | ? |
-------------------------
;
ARRBLT(A[1,1],$ ∂(X)[1,1],9); α fill A matrix;
ARRBLT(LENS[1],$ ∂(X)[4,1],3); α AND LENS CENTER;
ARRBLT(CFRAME[1],$ ∂(X)[5,1],3); α AND FRAME CENTER;
arrblt(ai[1,1],$ ∂(x)[6,1],9); α and inverse matrix;
COMMENT GET AN IMAGE,FIND SILOUTTE,FIT LINES,...;
S1← GLOBAL BOUNDARY ⊗ BLOBQ ; COMMENT GET CORNER DATA;
##### IF LENGTH (S1)=0
THEN BEGIN TYPE "NO BOUNDARY" EOM;
STATUS←status lor 2;
RETURN END;
X1←COP(S1);
C←GLOBAL DATUM(X1)[1,0]; COMMENT NUMBER OF CORNERS IN THE ARRAY;
TYPET "NUMBER OF CORNERS IS " & CVS(C) EOM;
STS←S1←SES←SVS←PHI;
VERTEDG←SU←SV←SW←PHI;
VERT0F←VERT0S←0; COMMENT FOR BACKUP ON WEDGES;
FOR I←1 S1U C DO
BEGIN
STR←GENSYM(POINT);
X←CVSI(STR,K);
IF K THEN BEGIN X←NEW(A1); NEW_PNAME(X,STR) END;
IF I=1 THEN U←X;
PUT X IN SVS;
DATUM(X)[5]←GLOBAL DATUM(X1)[1,I];
DATUM(X)[6]←GLOBAL DATUM(X1)[2,I];
DATUM(X)[4]←1.0;
FOR J←1 S1U 3 DO
DATUM(X)[J]←AI[J,1]*DATUM(X)[5]+AI[J,2]*DATUM(X)[6]+AI[J,3];
DATUM(X)[1]←DATUM(X)[1]/DATUM(X)[3];
DATUM(X)[2]←DATUM(X)[2]/DATUM(X)[3];
DATUM(X)[3]←0.0;
MAKE TTT⊗X≡NEW(DATUM(X));COMMENT SAVE FOR BACKUP;
IF I>1 THEN MAKE ENDPT⊗Y≡X;
STR←GENSYM(LINE);
Y←CVSI(STR,K);
IF K THEN BEGIN Y←NEW(0); NEW_PNAME(Y,STR) END;
MAKE ENDPT⊗Y≡X;
PUT Y IN SES;
END;
MAKE ENDPT⊗Y≡U;
∀ Y | YεSES ∧(VERT(Y)) DO
⊂ PUT Y IN VERTEDG; BVERT←TRUE ⊃;
if deb_simp
then ∀ x|xεsvs do
⊂ type '12&'15&"VERTEX "&PRINTNAME(X) EOM;
for i←1 step 1 until 6 do type cvg(∂(x)[i]) eos ⊃;
COMMENT simp_fit (continued) - pick the possibilities set;
if dis_simp
then do begin
itemvar l;safe real array itemvar x,v1,v2;
type "image display" eom;
dpyset(buf);
aivect(3*GLOBAL ∂(x1)[1,1]-512,-3*GLOBAL ∂(x1)[2,1]+512);
for i←2 step 1 until c do
avect(3*GLOBAL ∂(x1)[1,i]-512,-3*GLOBAL ∂(x1)[2,i]+512);
avect(3*GLOBAL ∂(x1)[1,1]-512,-3*GLOBAL ∂(x1)[2,1]+512);
∀ x|x ε svs do
⊂ aivect(3*∂(x)[5]-512,-3*∂(x)[6]+512);
dpysst(printname(x)) ⊃;
dpyout(D_FRAM);
type "input data " eom;inchrw;
dpyset(buf);
∀ l|l ε ses do
∀ v1,v2|endpt⊗l≡v1 ∧ endpt⊗l≡v2 ∧ (v1≠v2) do
⊂ aivect(3*∂(v1)[5]-512,-3*∂(v1)[6]+512);
avect(3*∂(v2)[5]-512,-3*∂(v2)[6]+512) ⊃;
type "local lines" eom;
dpyout(D_FRAM);
end until inchrw=".";
COMMENT DECIDE WHAT WE THINK WE ARE SEEING.;
SPECIAL_VERT←T←FALSE;
LAB12:
IF C=6
THEN BEGIN "C6"
IF BVERT
THEN BEGIN "VERTICAL CASE"
if deb_simp
then ⊂ type "VERTICAL(S) DETECTED." eom; wait ⊃;
V3←LOWEST(SVS);
S1←SVS;
REMOVE V3 FROM S1;
V4←LOWEST(S1);
COMMENT V2←NEXTV(V4,V3);
VA←NEXTV(V4,V3);
VB←NEXTV(V3,V4);
V2←HIGHEST({VA,VB});
IF V2=VB
THEN V3↔V4;
if deb_simp
then begin
type "THREE POINTS "&printname(V2)&
" "&printname(V3)&" "&printname(V4) eom;
wait;
end;
ASSIGN Y | ENDPT⊗Y≡V2 ∧ ENDPT⊗Y≡V3 HOLDS;
if deb_simp then begin type "Y ASSIGNED "&printname(Y) eom;wait end;
IF ABS(ANGLE(V2,V3,V4)-90.0)<40.0 ∨ (SPECIAL_VERT←(YεVERTEDG))
THEN BEGIN
POSSIBILITIES←($ PTYPE ` RPP) - {RHOMBOID};
TYPET "ITS'S A RECTANGULAR PARALLELEPIPED." EOM;
VERT1;
GO TO LAB15;
END;
POSSIBILITIES←{RHOMBOID};
TYPET "IT'S A RIGHT RHOMBOIDAL PRISM" EOM;
VERT1;
GO TO LAB15;
END "VERTICAL CASE";
POSSIBILITIES←{RHOMBOID};
TYPET "IT'S A RIGHT RHOMBOIDAL PRISM" EOM;
B1←LOWEST(SVS);
S1←SVS;
REMOVE B1 FROM S1;
B2←LOWEST(S1);
B3←NEXTV(B2,B1);
B←NEXTV(B1,B2);
VERT_PLANE_PT(B,B2,B1);
ASSIGN Y|ENDPT⊗Y≡B AND ENDPT⊗Y≡B2 HOLDS ;
LEN1←LENTH(Y);
COMMENT simp_fit (continued) - possibilities continued;
FOREACH Y| EDGE⊗RHOMBOID≡Y DO
BEGIN
LEN2←LENTH(Y);
IF SQRT((LEN2-LEN1)↑2)<0.15 THEN
BEGIN
V1←B;
V2←B2;
V3←B1;
V4←B3;
GO TO LAB15;
END;
END;
V1←NEXTV(B1,B3);
VERT_PLANE_PT(V1,B1,B3);
V2←B3;
V3←B1;
V4←B2;
END "C6"
ELSE
IF C=5
THEN BEGIN "C5"
IF( NOVERT←LENGTH(VERTEDG)) ≠ 0
THEN BEGIN
α check for degenerate RPPs;
S1←SVS;
V1←LOWEST(S1);V3←HIGHEST(S1);S1←S1-{V1,V3};
V2←LOWEST(S1);V4←HIGHEST(S1);S1←S1-{V2,V4};
X←COP(S1);
ASSIGN E1 | ENDPT⊗E1≡V1 AND ENDPT⊗E1≡V2 HOLDS;
ASSIGN E2 | ENDPT⊗E2≡V3 AND ENDPT⊗E2≡V4 HOLDS;
IF PARALLEL(E1,E2)
THEN BEGIN
POSSIBILITIES←($ PTYPE ` RPP) - {RHOMBOID};
FOREACH Y| ENDPT⊗Y≡X AND ENDPT⊗Y≡V1 DO V1↔V2;
V3←X;V4←NEXTV(V2,V3);
VERT_LINE_PT(V3,V2);
HORIZ_PLANE_PT(V4,V3);
GO TO LAB15;
END
END;
POSSIBILITIES←($ PTYPE ` WEDGE);
TYPET "IT'S A WEDGE." EOM;
IF DEB_SIMP
THEN BEGIN
TYPE "NO. VERTICALS DETECTED: "&CVS(NOVERT) EOM;
WAIT;
END;
CASE NOVERT OF
BEGIN VERT0; VERT1; VERT2 END;
GO TO LAB15;
END "C5"
ELSE
IF C=4
THEN BEGIN "C4" COMMENT DEGENERATE WEDGES;
##### IF ¬(NOVERT←LENGTH(VERTEDG))
THEN BEGIN
TYPET "DEGENERATE WEDGE??" EOM;
SORRY;
STATUS←STATUS LOR 10;
RETURN;
END;
X←HIGHEST(SVS);
ASSIGN E1,E2| E1εVERTEDG∧ENDPT⊗E1≡X∧ENDPT⊗E2≡X∧(E1≠E2) HOLDS;
ASSIGN E3| E3ε(SES-{E1,E2}) ∧ ADJ(E2,E3) HOLDS;
E4←COP(SES-{E1,E2,E3});
IF PARALLEL(E2,E4)
THEN GO TO LABFAIL;COMMENT RECTANGULAR FACE;
S1←ENDPT⊗E3;X5←LOP(S1);X4←LOP(S1);
LL1←ABS(DATUM(X4)[6]-DATUM(X5)[6]);
TYPE "GLITCH = " & CVG(LL1) EOM;
STR←GENSYM(POINT); X3←CVSI(STR,K);
IF K
THEN BEGIN X3←NEW(DATUM(X));NEW_PNAME(X3,STR) END;
PUT X3 IN SVS;
DATUM(X3)[6]←DATUM(X3)[6]+LL1;
FOR J←1 S1U 3 DO
DATUM(X3)[J]←AI[J,1]*DATUM(X3)[5]+AI[J,2]*DATUM(X3)[6]+AI[J,3];
DATUM(X3)[1]←DATUM(X3)[1]/DATUM(X3)[3];
DATUM(X3)[2]←DATUM(X3)[2]/DATUM(X3)[3];
DATUM(X3)[3]←0.0;
ERASE ENDPT⊗E1≡X;MAKE ENDPT⊗E1≡X3;
V1←X3; V2←COP(ENDPT⊗E1-{X3});
V3←NEXTV(V1,V2); V4←NEXTV(V2,V3);
STR←GENSYM(LINE);Y←CVSI(STR,K);
IF K
THEN BEGIN Y←NEW(LL1); NEW_PNAME(Y,STR) END;
PUT Y IN SES;
MAKE ENDPT⊗Y≡X3; MAKE ENDPT⊗Y≡X;
POSSIBILITIES←($ PTYPE ` WEDGE);
VERT_LINE_PT(V1,V2);
GO TO LAB15;
END "C4"
ELSE
IF C=8
THEN BEGIN
POSSIBILITIES←{LBEAM};
GO LAB15;
END ;
LABFAIL:
BEGIN SORRY;
COMMENT WRONG NUMBER OF OUTSIDE EDGES;
STATUS ← STATUS LOR 20;
SIMP_ERASE;
TYPET "WRONG NUMBER OF EDGES" EOM;
##### RETURN;
END;
COMMENT simp_fit (continued) - model matching
4 3-D POINTS HAVE BEEN LOCATED DURING THE RECOGNITION PROCESS,
NOW WE COMPUTE THE 3 EDGE LENGTHS TO BE USED FOR MATCHING;
LAB15:
IF DEB_SIMP
THEN WAIT;
SL1←SL2←SL3←PHI;
L1←L2←L3←NO_ITEM;
ASSIGN L1| ENDPT⊗L1≡V1 AND ENDPT⊗L1≡V2 HOLDS;
ASSIGN L2| ENDPT⊗L2≡V2 AND ENDPT⊗L2≡V3 HOLDS;
ASSIGN L3| ENDPT⊗L3≡V3 AND ENDPT⊗L3≡V4 HOLDS;
IF L1=NO_ITEM THEN TYPE "L1 NOT ASSIGNED" EOM;
IF L2=NO_ITEM THEN TYPE "L2 NOT ASSIGNED" EOM;
IF L3=NO_ITEM THEN TYPE "L3 NOT ASSIGNED" EOM;
TYPET "LINES:"&PRINTNAME(L1)&" "&PRINTNAME(L2)&" "&
PRINTNAME(L3) EOM;
LL1←LENTH(L1);
LL2←LENTH(L2);
LL3←LENTH(L3);
IF DEB_SIMP THEN
BEGIN
TYPE "POINTS: "&PRINTNAME(V1)&" "&PRINTNAME(V2)
&" "&PRINTNAME(V3)&" "&PRINTNAME(V4) EOM;
TYPE "LL1="&CVG(LL1)&" LL2="&CVG(LL2)&" LL3="&CVG(LL3) EOM ;
WAIT;
END;
IF LL1<.1 ∧ LL1<.1 ∧ LL3≤.1
THEN BEGIN STATUS←status lor 4;
TYPE "CUBE TOO SMALL TO BE RECOGNIZED" EOM;
RETURN;
END;
COMMENT NOW LOOK AT EACH POSSIBLE PROTOTYPE FOR THE MATCH!;
FOREACH PPTYPE | PPTYPE ε POSSIBILITIES DO
BEGIN "MATCH"
LABEL LAB16;
SL1←SL2←SL3←PHI;
COMMENT SORT MODEL EDGES INTO SETS OF LENGTH LL1,LL2,LL3;
FOREACH Y | GLOBAL EDGE⊗PPTYPE≡Y DO
BEGIN
LX←GLENTH(Y);
IF LAEQ(LX,LL1) THEN PUT Y IN SL1;
IF LAEQ(LX,LL2) THEN PUT Y IN SL2;
IF LAEQ(LX,LL3) THEN PUT Y IN SL3;
END;
COMMENT simp_fit (continued) - match three vectors
;
LAB16:
if deb_simp
then begin
type "TRYING "&PRINTNAME(PPTYPE) eom;
type "NUMBER IN SL1,SL2,SL3:"&CVG(LENGTH(SL1))&
" "&CVG(LENGTH(SL2))&" "&CVG(LENGTH(SL3)) EOM ;
wait;
end;
FOR I←1 S1U 3 DO
BEGIN VL1[I]←DATUM(V2)[I]-DATUM(V1)[I];
VL2[I]←DATUM(V3)[I]-DATUM(V2)[I];
VL3[I]←DATUM(V4)[I]-DATUM(V3)[I];
END;
IF FALSE
THEN BEGIN "MATCH EDGES"
MDP1←-1.0;
∀ U | UεSL1 DO
BEGIN
SETE←(GLOBAL ENDPT⊗U);
UH←LOP(SETE);
UT←COP(SETE);
FOR I←1 S1U 3 DO MU[I]←GLOBAL ∂(UH)[I] - GLOBAL ∂(UT)[I];
DOT←DOT_PROD(MU,VL1);
IF DOT<0
THEN BEGIN UT↔UH; DOT←-DOT; END;
IF DOT>MDP1 THEN MDP1←DOT;
MAKE UHEAD⊗U≡UH;
MAKE UTAIL⊗U≡UT;
MAKE UDOT⊗U≡NEW(DOT);
END;
if deb_simp
then type "U VECTORS"&CVG(LENGTH (SL1)) eom;
MDP2←-1.0;
∀ V | VεSL2 DO
BEGIN
SETE←(GLOBAL ENDPT⊗V);
VH←LOP(SETE);
VT←COP(SETE);
FOR I←1 S1U 3 DO MV[I]←GLOBAL ∂(VH)[I] - GLOBAL ∂(VT)[I];
DOT←DOT_PROD(MV,VL2);
IF DOT<0
THEN BEGIN VT↔VH; DOT←-DOT; END;
IF DOT>MDP2 THEN MDP2←DOT;
MAKE VHEAD⊗V≡VH;
MAKE VTAIL⊗V≡VT;
MAKE VDOT⊗V≡NEW(DOT);
END;
if deb_simp
then type "V VECTORS"&CVG(LENGTH (SL2)) eom;
MDP3←-1.0;
∀ W | WεSL3 DO
BEGIN
SETE←(GLOBAL ENDPT⊗W);
WH←LOP(SETE);
WT←COP(SETE);
FOR I←1 S1U 3 DO MW[I]←GLOBAL ∂(WH)[I] - GLOBAL ∂(WT)[I];
DOT←DOT_PROD(MW,VL3);
IF DOT<0
THEN BEGIN WT↔WH; DOT←-DOT; END;
IF DOT>MDP3 THEN MDP3←DOT;
MAKE WHEAD⊗W≡WH;
MAKE WTAIL⊗W≡WT;
MAKE WDOT⊗W≡NEW(DOT);
END;
if deb_simp
then type "W VECTORS"&CVG(LENGTH (SL3)) eom;
BEGIN "INNER"
if deb_simp
then type "BEGIN INNER" EOM;
∀ U,UX | UDOT⊗U≡UX ∧ (∂(UX)=MDP1) DO
BEGIN
ASSIGN UH|UHEAD⊗U≡UH HOLDS;
ASSIGN UT|UHEAD⊗U≡UT HOLDS;
VT←UH;
∀ V,VX|VTAIL⊗V≡VT ∧ VDOT⊗V≡VX ∧ (∂(VX)=MDP2) DO
BEGIN ASSIGN VH|VHEAD⊗V≡VH HOLDS;
WT←VH;
∀ W,WX|WTAIL⊗W≡WT ∧ WDOT⊗W≡WX ∧ (∂(WX)=MDP3) DO
BEGIN ASSIGN WH|WHEAD⊗W≡WH HOLDS;
if deb_simp
then type "ASSIGN SUCCEEDS" eom;
GO TO LABA;
END;
END;
END;
if deb_simp
then type "INNER FAILS" EOM;
END "INNER";
END "MATCH EDGES"
ELSE
BEGIN "OLD MATCH"
CROSS_PROD(VL2,VL3,CP1);
DP1←DOT_PROD(CP1,VL1);
FOREACH U,V,W|UεSL1 ∧ VεSL2 ∧ GADJ(U,V) ∧
WεSL3 ∧ GADJ(V,W) ∧ (¬GADJ(U,W)) DO
BEGIN ASSIGN MV2|GLOBAL ENDPT⊗U≡MV2 ∧ GLOBAL ENDPT⊗V≡MV2 HOLDS;
ASSIGN MV3|GLOBAL ENDPT⊗V≡MV3 ∧ GLOBAL ENDPT⊗W≡MV3 HOLDS;
MV1←COP((GLOBAL ENDPT⊗U)-{MV2});
MV4←COP((GLOBAL ENDPT⊗W)-{MV3});
FOR I←1 S1U 3 DO
BEGIN MVL1[I]←GLOBAL ∂(MV2)[I]-GLOBAL ∂(MV1)[I];
MVL2[I]←GLOBAL ∂(MV3)[I]-GLOBAL ∂(MV2)[I];
MVL3[I]←GLOBAL ∂(MV4)[I]-GLOBAL ∂(MV3)[I];
END;
CROSS_PROD(MVL2,MVL3,MCP1);
MDP1←DOT_PROD(MCP1,MVL1);
IF MDP1*DP1>0
THEN BEGIN
UH←MV2;
VH←MV3;
WH←MV4;
GO TO LABA;
END;
END;
END "OLD MATCH";
END "MATCH";
IF DEB_SIMP
THEN BEGIN
TYPE "SCREWUP IN MATCHING PROCESS." EOM;
WAIT;
END;
IF C=5
THEN BEGIN
FOREACH X,XX|XεSVS ∧ TTT⊗X≡XX DO ARRTRAN(DATUM(X), DATUM(XX));
IF NOVERT=2 THEN BEGIN NOVERT←0;VERT0;GO TO LAB15 END;
IF NOVERT=0 ∧¬VERT0S THEN BEGIN VERT0S←1;VERT0;GOTO LAB15;END;
END;
STATUS ← STATUS LOR 2;
SIMP_ERASE;
SORRY;
##### RETURN;
LABA:
if TYP_SIMP
then type "SUCCESSFUL PROTOTYPE/INSTANCE MATCH" EOM;
if FALSE
then begin
type "U,V,W:"&PRINTNAME(U)&","&PRINTNAME(V)&","&PRINTNAME(W) eom;
type "ut,uh,vh,wh:"&printname(mv1)&","&printname(mv2)&","&printname(mv3)&
","&printname(mv4) eom;
type "v1,v2,v3,v4:"&printname(v1)&","&printname(v2)&","&
printname(v3)&","&printname(v4) eom;
end;
COMMENT simp_fit (continued) - get transform and finish
SOLVE FOR T MATRIX - THE TRANSFORM FROM MODEL TO REAL WORLD;
FINDX(V2,V3,V4,UH,VH,WH);
GOTIT ← THISOB ← GLOBAL NEW(TT); COMMENT THIS IS WHAT WE FOUND;
ARRTRAN( GLOBAL DATUM(GOTIT), TT);
COMMENT NOW MOVE EACH MODEL EDGE OUT INTO THE REAL WORLD & PROJECT IT INTO AN IMAGE;
S1←GLOBAL XFORM⊗BLOBQ;
X←COP(S1);
##### GLOBAL MAKE XFORM⊗THISOB≡ X;
##### GLOBAL MAKE INSTANCE⊗PPTYPE≡GOTIT;
GLOBALIZE(THISOB,PPTYPE,TT);
SIMP_ERASE; COMMENT DONE WITH THE LOCAL MODEL;
END "SIMP"; COMMENT OF ;
COMMENT INITIALIZATION AND COMMAND SCANNER;
TTT←NEW;
NEXTSYM←NEW;
D_FRAM ← -1;
OVERLAY←-1;
OPEN(1,"TTY",1,1,1,80,BREAK,EOF);
SETFORMAT(10,6);
SIMP_INIT;
SEND_MESS←TRUE;
IF ¬YES_SIMP
THEN PUT_DATA(0,0,"SIMP"); COMMENT THIS PUTS OUT VERSION NUMBER FOR SEGMENT;
if deb_simp
then begin
MONRUN: type "GET OBJECTS FROM DISK? (Y or N)" eom;
if (STR←inchwl)="Y"
then go GETDISK;
end;
IF RUN
THEN BEGIN "UNDER H/E MONITOR"
if TYP_SIMP
then type "RUNNING UNDER H/E MONITOR" eom;
IF ¬YES_SIMP
THEN YES_SIMP ← TRUE;
WHILE TRUE DO
BEGIN "MESSAGE LOOP"
INTEGER I,J;
J←I←GET_ENTRY('120,NULL,"SIMP",NULL);
CURMES←GET_DATA(1,I); COMMENT GET SOURCE OF MESSAGE;
I←QUEUE ('600,I ); COMMENT ACTIVATE AND ACKNOWLEDGE ;
comment if ¬i then issue(1,"simp",curmes,message confuse(j));
END "MESSAGE LOOP";
END "UNDER H/E MONITOR";
TYPE "GETTING OBJECTS FROM DISK" EOM;
BEGIN "GET FROM DISK"
GETDISK:
DEB_SIMP←TYP_SIMP←DIS_SIMP←TRUE;
type "OBJECTS FROM DISK" eom;
SEND_MESS←FALSE;
WHILE TRUE DO
BEGIN "DISK READIN LOOP"
type "READ IN A SCENE" eom;
READ_FROM_DISK;
WHILE TRUE DO
IF LENGTH(BLOBS)
THEN BEGIN
XR←LOP(BLOBS);
IF DATUM(XR)=-999.0
THEN GO MONRUN;
SIMP_FIT(XR,STAT_II,ITVAR_II←NIL);
DEBUG_UPDATE;
TYPE "FIT FINISHED WITH STATUS "&CVS(STAT_II) EOM;
END
ELSE BEGIN
TYPE "NO BLOBS IN DISK FILE" EOM;
DONE;
END;
END "DISK READIN LOOP";
END "GET FROM DISK";
END "SIMPLE";